home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / sets.t < prev    next >
Encoding:
Text File  |  1988-05-02  |  3.7 KB  |  128 lines
  1. (herald sets)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; Utility operations on sets: ADJOIN, UNION, INTERSECTION, REMQ, SETDIFF
  27.  
  28. ;;; The empty set.
  29.  
  30. (define (empty-set)
  31.   '())
  32.  
  33. ;;; Is member an element of set.                    
  34.  
  35. (define (member-of-set? set member)
  36.   (memq? set member))
  37.  
  38. (define (set-member? x s)                       ;defunct
  39.   (memq? x s))
  40.  
  41. ;;; Add an element X to a set S.
  42.  
  43. (define (adjoin x s)                            ;defunct
  44.   (if (memq? x s) s (cons x s)))
  45.  
  46. (define (add-to-set set member)
  47.   (if (memq? member set) set (cons member set)))
  48.  
  49. ;;; Union of two sets.
  50.  
  51. (define (union x y)
  52.   (if (null? x)
  53.       y
  54.       (do ((y y (cdr y))
  55.            (r x (if (memq? (car y) r)
  56.                     r
  57.                     (cons (car y) r))))
  58.           ((null? y) r))))
  59.  
  60. ;;; Intersection of two sets.
  61.  
  62. (define (intersection x y)
  63.   (if (null? y)
  64.       '()
  65.       (iterate loop ((x x) (res '()))
  66.         (cond ((null? x) res)
  67.               ((memq? (car x) y)
  68.                (loop (cdr x) (cons (car x) res)))
  69.               (else
  70.                (loop (cdr x) res))))))
  71.  
  72. ;;; Is the intersection of X and Y nonempty.
  73.  
  74. (define (intersection? x y)
  75.   (if (null? y)
  76.       nil
  77.       (iterate loop ((x x))
  78.         (cond ((null? x)
  79.                nil)
  80.               ((memq? (car x) y)
  81.                t)
  82.               (else
  83.                (loop (cdr x)))))))
  84.  
  85. ;;; Remove an element X from a set S, non-destructively.  The result shares
  86. ;;; storage with S.
  87.  
  88. (define (setremq x s)
  89.   (cond ((null? s) s)
  90.         ((eq? (car s) x)
  91.          (cdr s))
  92.         (else
  93.          (let ((y (setremq x (cdr s))))
  94.            (if (eq? y (cdr s))
  95.                s
  96.                (cons (car s) y))))))
  97.  
  98. (define (remove-from-set set member)
  99.   (cond ((null? set) set)
  100.         ((eq? (car set) member)
  101.          (cdr set))
  102.         (else
  103.          (let ((elt (remove-from-set (cdr set) member)))
  104.            (if (eq? elt (cdr set))
  105.                set
  106.                (cons (car set) elt))))))
  107.  
  108.  
  109.  
  110. ;;; Difference of two sets: (SETDIFF A B) = everything in A that is not in B.
  111.  
  112. (define (setdiff x y)
  113.   (do ((x x (cdr x))
  114.        (r '() (if (memq? (car x) y)
  115.                   r
  116.                   (cons (car x) r))))
  117.       ((null? x) r)))
  118.  
  119. (define set-difference setdiff)
  120.  
  121. ;;; Mapping down a set
  122.  
  123. (define (map-set f s)
  124.   (map f s))
  125.  
  126. (define (walk-set f s)
  127.   (walk f s))
  128.